

;
; expr-statements utilities:
; mapping table: *expr-statements*, definition helper: def-expr-handler,
; caller helper: call-expr-handler
;
(setf *expr-statements* (make-hash-table))

(defmacro def-expr-handler (expr-name args &rest body)
  (assert (and (symbolp expr-name) (listp args)))
  `(progn
     (if (gethash ',expr-name *expr-statements*)
       (error (format nil "redefinition of ~a" expr-name)))
     (setf (gethash ',expr-name *expr-statements*)
           (lambda ,args ,@body))
     ))

(defun call-expr-handler (expr-name ast-printing-context args)
  (assert (and (symbolp expr-name) (list args)))
  (let ((handler (gethash expr-name *expr-statements*)))
    (unless handler (error (format nil "expression handler '~a' is undefined"
                                   expr-name)))

    ; return the evaluated expression
    (eval (append (list 'funcall handler ast-printing-context) args))
    ))

;
; expression handler:
; (if predicate-expression then-statement &optional else-statement)
;
(def-expr-handler if (context
                      predicate-expression then-block &optional else-block)
  ; if-block
  (printm context
	  "if( " predicate-expression " )" *new-line*
	  )

  ; then-block
  (stringify-block-expression context then-block)

  ; optional else-block
  (if else-block
      (progn
	(printm context "else" *new-line*)
	(stringify-block-expression)))
  )

;
; (return function-expression) -> return function-expression;
;
(def-expr-handler return (context expr)
  (printm context "return" #\Space)
  (stringify-expression context expr)
  )

;
; (var type variable-name) -> type variable-name;
;
(def-expr-handler var (context type-decl var-name)
  (error "not implemented"))


(def-expr-handler = (context l-value r-value)
  ())

;
; stringifies atomic expression
;
(defun stringify-atom (context var-expr)
  (assert (atom var-expr))
  (princ var-expr (ast-printing-context-ostream context))
  )
;
; stringifies expression being used in the function body
;
(defun stringify-expression (context expr)
  (if (listp expr)
      (progn
	(call-expr-handler (car expr) context (cdr expr))
	(printm context ";" *new-line*))
      ; stringify atom
      (stringify-atom context expr)))

;
; stringifies block expression (i.e. operational structures being
; used in the function bodies)
;
(defun stringify-block-expression (context block-expression)
  (let (
	(next-indent-str (conc-string "" *indentation-unit*))
        )
    ; add open brace
    (printm context "{" *new-line*)

    (stringify-expression context block-expression)

    ; add close brace
    (printm context "}" *new-line*)
    )
  )

(def-ast-handler test (ast-context name)
  (format t "ast-handler-test (~a ~a)~%" ast-context name)
  (+ 1 2)
  )

(def-ast-handler func (context
		       ret-type name args &key
		       ((:comment comment) nil)
		       ((:body body) nil)
                       ((:lang-name lang-name) name)
		       )
  (printm context "/* " comment "*/" *new-line*)

  ; stringify return type
  (stringify-typename context ret-type)
  (printm context " " lang-name)

  ; stringify arguments list 
  (stringify-arg-list context args)
  (printm context *new-line*)

  ; stringify function body
  (if body
    (format t "~a" (stringify-block-expression context body)))
  )

(setf *test-form1* '(func int main (
                                    (int argc)
                                    ((ptr (ptr (const char))) argv)
                                    )
                          :lang-name "main"
                          :comment "defines entry in the console application"
                          :body (return 0)))

(setf *test-form2* '(func int foo ((long-long arg))
                          :comment "quite a simple foo function"
                          :body (return (+ arg 1))))

(defun test-seq0 ()
  (let ((context (make-ast-printing-context :ostream *standard-output*)))
    (process-ast-list context *test-form1*)
    ;(process-ast-list 778 '(test "test.c"))
    ))


